home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / HalfBrite / HalfBrite.p
Encoding:
Text File  |  1997-05-06  |  2.4 KB  |  94 lines
  1. program HalfbriteDemo;
  2.  
  3. { ==================================================================
  4.  
  5.     HalfBriteDemo.p ; (P) 1992 by "Diesel" B. Künnen
  6.  
  7.     Nur, um mal den Halfbrite-Modus unter PCQ-Pascal zu
  8.     demonstrieren. Ach ja, HalfBrite.p ist Public Domain.
  9.  
  10.   ================================================================== }
  11.  
  12.  
  13. {$I "Include:intuition/intuition.i" }
  14. {$I "Include:Graphics/Graphics.i" }
  15. {$I "Include:Graphics/Pens.i" }
  16. {$I "Include:Exec/Libraries.i" }
  17. {$I "Include:Graphics/View.i" }
  18. {$I "Include:libraries/dos.i" }
  19.  
  20. Const    { ---  Screendaten (wichtig: Extra_HalfBrite)  --- }
  21.  
  22.     NS : NewScreen=(0,0,320,200,6,0,1,Extra_HalfBrite,
  23.             Customscreen_f, NIL,NIL,NIL,NIL);
  24.  
  25.     { --- Windowdaten --- }
  26.  
  27.     NW : NewWindow=(0,0,320,200,0,1,0,
  28.             Smart_Refresh+Backdrop+Borderless+
  29.             Activate+NoCareRefresh,
  30.             NIL,NIL,NIL,NIL,NIL,0,0,0,0,
  31.             CustomScreen_f);
  32.  
  33. Var
  34.     DScreen    : ScreenPtr;
  35.     DWindow    : WindowPtr;
  36.     i    : Short;
  37.  
  38.  
  39. Procedure CleanExit(why : String; rt : Integer);
  40.  
  41.     { --- System sauber zurücklassen --- }
  42. Begin
  43.     If DWindow<>NIL then CloseWindow(DWindow);
  44.     If DScreen<>NIL then CloseScreen(DScreen);
  45.     If GfxBase<>NIL then CloseLibrary(GfxBase);
  46.  
  47.     If why<>NIL then writeln(why);
  48.     Exit(rt);
  49. End;
  50.  
  51.  
  52. { ======================  Main  ====================== }
  53.  
  54. Begin
  55.     { --- zuerst die Gfx.lib öffnen --- }
  56.     GfxBase:=OpenLibrary("graphics.library",0);
  57.     If GfxBase=NIL then CleanExit("No Gfx.lib\n",10);
  58.  
  59.     { --- Screen aufmachen --- }
  60.     DScreen:=OpenScreen(Adr(NS));
  61.     If DScreen=NIL then CleanExit("Cannot open screen\n",5);
  62.  
  63.     { --- Window öffnen --- }
  64.     NW.Screen:=DScreen;
  65.     DWindow:=OpenWindow(Adr(NW));
  66.     If DWindow=NIL then CleanExit("Cannot open window\n",5);
  67.  
  68.     { --- Titlebar verstecken --- }
  69.     ShowTitle(DScreen, False);
  70.  
  71.     write("Quit bei Maus in linker oberer Ecke\n");
  72.  
  73.     { --- 32 Balken, oben und unten, zeichnen --- }
  74.     For i:=0 to 31 do
  75.     Begin
  76.       { --- Wähle Farbe 0..31  &  male oben ein Rechteck --- }
  77.       SetAPen  (DWindow^.RPort, i);
  78.       RectFill (DWindow^.RPort, i*10,   1, 9+i*10, 100);
  79.  
  80.       { --- Wähle Farbe 32..63 &  male unten ein Rechteck --- }
  81.       SetAPen  (DWindow^.RPort, i+32);
  82.       RectFill (DWindow^.RPort, i*10, 101, 9+i*10, 200);
  83.     End;
  84.  
  85.     { --- Warten, bis Mauszeiger in linker, oberer Ecke --- }
  86.     Repeat
  87.       Delay(5);    { --- Prozeß auf Wait() setzen --- }
  88.  
  89.     until ((DWindow^.MouseX=0) AND (DWindow^.MouseY=0));
  90.  
  91.     CleanExit(Nil,0);    { ---  bye ...  --- }
  92.  
  93. End.
  94.